home *** CD-ROM | disk | FTP | other *** search
/ PC World 2007 March / PCWorld_2007-03_cd.bin / domacnost a kancelar / scribus / scribus-1.3.3.7-win32-install.exe / tcl / tcl8.4 / word.tcl < prev   
Text File  |  2002-10-31  |  4KB  |  133 lines
  1. # word.tcl --
  2. #
  3. # This file defines various procedures for computing word boundaries
  4. # in strings.  This file is primarily needed so Tk text and entry
  5. # widgets behave properly for different platforms.
  6. #
  7. # Copyright (c) 1996 by Sun Microsystems, Inc.
  8. # Copyright (c) 1998 by Scritpics Corporation.
  9. #
  10. # See the file "license.terms" for information on usage and redistribution
  11. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  12. # 
  13. # RCS: @(#) $Id: word.tcl,v 1.7 2002/11/01 00:28:51 andreas_kupries Exp $
  14.  
  15. # The following variables are used to determine which characters are
  16. # interpreted as white space.  
  17.  
  18. if {[string equal $::tcl_platform(platform) "windows"]} {
  19.     # Windows style - any but a unicode space char
  20.     set tcl_wordchars "\\S"
  21.     set tcl_nonwordchars "\\s"
  22. } else {
  23.     # Motif style - any unicode word char (number, letter, or underscore)
  24.     set tcl_wordchars "\\w"
  25.     set tcl_nonwordchars "\\W"
  26. }
  27.  
  28. # tcl_wordBreakAfter --
  29. #
  30. # This procedure returns the index of the first word boundary
  31. # after the starting point in the given string, or -1 if there
  32. # are no more boundaries in the given string.  The index returned refers
  33. # to the first character of the pair that comprises a boundary.
  34. #
  35. # Arguments:
  36. # str -        String to search.
  37. # start -    Index into string specifying starting point.
  38.  
  39. proc tcl_wordBreakAfter {str start} {
  40.     global tcl_nonwordchars tcl_wordchars
  41.     set str [string range $str $start end]
  42.     if {[regexp -indices "$tcl_wordchars$tcl_nonwordchars|$tcl_nonwordchars$tcl_wordchars" $str result]} {
  43.     return [expr {[lindex $result 1] + $start}]
  44.     }
  45.     return -1
  46. }
  47.  
  48. # tcl_wordBreakBefore --
  49. #
  50. # This procedure returns the index of the first word boundary
  51. # before the starting point in the given string, or -1 if there
  52. # are no more boundaries in the given string.  The index returned
  53. # refers to the second character of the pair that comprises a boundary.
  54. #
  55. # Arguments:
  56. # str -        String to search.
  57. # start -    Index into string specifying starting point.
  58.  
  59. proc tcl_wordBreakBefore {str start} {
  60.     global tcl_nonwordchars tcl_wordchars
  61.     if {[string equal $start end]} {
  62.     set start [string length $str]
  63.     }
  64.     if {[regexp -indices "^.*($tcl_wordchars$tcl_nonwordchars|$tcl_nonwordchars$tcl_wordchars)" [string range $str 0 $start] result]} {
  65.     return [lindex $result 1]
  66.     }
  67.     return -1
  68. }
  69.  
  70. # tcl_endOfWord --
  71. #
  72. # This procedure returns the index of the first end-of-word location
  73. # after a starting index in the given string.  An end-of-word location
  74. # is defined to be the first whitespace character following the first
  75. # non-whitespace character after the starting point.  Returns -1 if
  76. # there are no more words after the starting point.
  77. #
  78. # Arguments:
  79. # str -        String to search.
  80. # start -    Index into string specifying starting point.
  81.  
  82. proc tcl_endOfWord {str start} {
  83.     global tcl_nonwordchars tcl_wordchars
  84.     if {[regexp -indices "$tcl_nonwordchars*$tcl_wordchars+$tcl_nonwordchars" \
  85.         [string range $str $start end] result]} {
  86.     return [expr {[lindex $result 1] + $start}]
  87.     }
  88.     return -1
  89. }
  90.  
  91. # tcl_startOfNextWord --
  92. #
  93. # This procedure returns the index of the first start-of-word location
  94. # after a starting index in the given string.  A start-of-word
  95. # location is defined to be a non-whitespace character following a
  96. # whitespace character.  Returns -1 if there are no more start-of-word
  97. # locations after the starting point.
  98. #
  99. # Arguments:
  100. # str -        String to search.
  101. # start -    Index into string specifying starting point.
  102.  
  103. proc tcl_startOfNextWord {str start} {
  104.     global tcl_nonwordchars tcl_wordchars
  105.     if {[regexp -indices "$tcl_wordchars*$tcl_nonwordchars+$tcl_wordchars" \
  106.         [string range $str $start end] result]} {
  107.     return [expr {[lindex $result 1] + $start}]
  108.     }
  109.     return -1
  110. }
  111.  
  112. # tcl_startOfPreviousWord --
  113. #
  114. # This procedure returns the index of the first start-of-word location
  115. # before a starting index in the given string.
  116. #
  117. # Arguments:
  118. # str -        String to search.
  119. # start -    Index into string specifying starting point.
  120.  
  121. proc tcl_startOfPreviousWord {str start} {
  122.     global tcl_nonwordchars tcl_wordchars
  123.     if {[string equal $start end]} {
  124.     set start [string length $str]
  125.     }
  126.     if {[regexp -indices \
  127.         "$tcl_nonwordchars*($tcl_wordchars+)$tcl_nonwordchars*\$" \
  128.         [string range $str 0 [expr {$start - 1}]] result word]} {
  129.     return [lindex $word 0]
  130.     }
  131.     return -1
  132. }
  133.